home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d19 / cal14s13.arc / CALLS.PAS < prev    next >
Pascal/Delphi Source File  |  1989-04-08  |  60KB  |  2,106 lines
  1.  
  2. {$M 50000,30000,500000}  {Stack, minheap, maxheap}
  3.  
  4. {$V-}    {Relax string rules}
  5. {$S-}    {Stack testing}
  6. {$R-}    {Range checks}
  7. {$L+}    {Local debug info}
  8. {$D+}    {Global debug info}
  9.  
  10. program caller_log_report;
  11.  
  12. uses Dos, Qread, ansiCrt;
  13.  
  14.  
  15. {                 PCBoard Call Analyzer Ver. 11.7  02/19/87                }
  16. {                                                                          }
  17. {       PCBoard Call Analyzer written by Warren Lauzon of Phoenix AZ       }
  18. {                 Phoenix Techline PCBoard   602-936-3058                  }
  19. {                                                                          }
  20. {      (updated for PCBoard 11.8 and PCB ProDOOR, S.H.Smith, 09/02/87)     }
  21. {              (updated for PCBoard 12.1 S.H.Smith, 11/20/87)              }
  22.  
  23.  
  24. const
  25.    version = '14s13';
  26.    reldate = '04-09-89';
  27.    pcbversion = 'For PCBoard v14.1';
  28.  
  29. type
  30.    anystring = string[80];
  31.    FileStr = string[64]; {array[1..64] of char;}
  32.    char64 = array[1..64] of char;
  33.  
  34.    ItemPointer = ^ItemList;
  35.    ItemList = record
  36.                  name : string[20];
  37.                  count : longint;
  38.                  next : ItemPointer;
  39.               end;
  40.  
  41.    FilePointer = ^FileRec;
  42.    FileRec = record
  43.                 name : string[16];
  44.                 count : longint;
  45.                 size : longint;
  46.                 higher : FilePointer;
  47.                 lower : FilePointer;
  48.              end;
  49.  
  50.    ProtocolRecord = record
  51.                        Code : char;
  52.                        Name : string[20];
  53.                        Uploads : longint; {count of uploads}
  54.                        UpTime : real; {time spent uploading}
  55.                        UpIdeal : real; {ideal time if 100% efficient}
  56.                        Downloads : longint;
  57.                        DownTime : real;
  58.                        DownIdeal : real;
  59.                     end;
  60.  
  61. const
  62.    ProtocolCount = 27;
  63.    Protocol : array[1..ProtocolCount] of ProtocolRecord = (
  64.       (Code : 'A'; Name : 'ASCII'),
  65.       (Code : 'B'; Name : 'B'),
  66.       (Code : 'C'; Name : 'CRC Xmodem'),
  67.       (Code : 'D'; Name : 'D'),
  68.       (Code : 'E'; Name : 'E'),
  69.       (Code : 'F'; Name : 'Full Flow'),
  70.       (Code : 'G'; Name : 'Ymodem-G (dsz)'),
  71.       (Code : 'H'; Name : 'H'),
  72.       (Code : 'I'; Name : 'I'),
  73.       (Code : 'J'; Name : 'Jmodem'),
  74.       (Code : 'K'; Name : 'Kermit'),
  75.       (Code : 'L'; Name : 'Sysop (Local)'),
  76.       (Code : 'M'; Name : 'M'),
  77.       (Code : 'N'; Name : 'N'),
  78.       (Code : 'O'; Name : '1K-Xmodem'),
  79.       (Code : 'P'; Name : 'PCP-Zmodem'),
  80.       (Code : 'Q'; Name : 'Q'),
  81.       (Code : 'R'; Name : 'Zmodem Resume'),
  82.       (Code : 'S'; Name : 'S'),
  83.       (Code : 'T'; Name : 'T'),
  84.       (Code : 'U'; Name : 'U'),
  85.       (Code : 'V'; Name : 'V'),
  86.       (Code : 'W'; Name : 'Window Xmodem'),
  87.       (Code : 'X'; Name : 'Xmodem'),
  88.       (Code : 'Y'; Name : 'Ymodem Batch'),
  89.       (Code : 'Z'; Name : 'Zmodem Batch'),
  90.       (Code : '?'; Name : 'Others')  {must be last}
  91.    );
  92.  
  93.  
  94. {$i stoupper.inc}
  95.  
  96. (* -------------------------------------------------------- *)
  97. const
  98.    maxdir = 60;
  99.  
  100.    red:     string[7] = #27'[1;31m';
  101.    green:   string[7] = #27'[1;32m';
  102.    yellow:  string[7] = #27'[1;33m';
  103.    blue:    string[7] = #27'[1;34m';
  104.    magenta: string[7] = #27'[1;35m';
  105.    cyan:    string[7] = #27'[0;36m';
  106.    white:   string[7] = #27'[1;37m';
  107.    gray:    string[7] = #27'[0m';
  108.  
  109.  
  110.  
  111. (* -------------------------------------------------------- *)
  112. const
  113.    viewmember : longint = 0;   {number of zip member textviews}
  114.    extmember : longint = 0;    {number of zip member extracts}
  115.    repacks : longint = 0;      {number of re-ziphive runs}
  116.    testexec : longint = 0;     {number of ziphives tested}
  117.    viewexec : longint = 0;     {number of 'view executed'}
  118.    B38400 : longint = 0;       {Baud rate calls}
  119.    B19200 : longint = 0;
  120.    B9600 : longint = 0;
  121.    B4800 : longint = 0;
  122.    B2400 : longint = 0;
  123.    B1200 : longint = 0;
  124.    B300 : longint = 0;
  125.    backdos : longint = 0;      {number of times back from dos}
  126.    batchs : longint = 0;       {number of batch transfers}
  127.    baud : word = 0;            {current caller's baud rate}
  128.    Blocal : longint = 0;
  129.    blts : longint = 0;         {bulletins read}
  130.    caller : longint = 0;       {number of callers}
  131.    comments : longint = 0;     {number of comments}
  132.    dirscan : longint = 0;      {number of DIR scans}
  133.    DOORs : longint = 0;        {number of DOORs opened}
  134.    DosTimes : longint = 0;     {how many times dropped to DOS}
  135.    down : longint = 0;         {number of downloads}
  136.    d_abort : longint = 0;      {number of download aborts}
  137.    elapsed_time : real = 0;    {how long it takes the program to run}
  138.    Endtime : real = 0;         {End time for program start}
  139.    events : longint = 0;       {event timer activated}
  140.    even_parity : longint = 0;  {7E callers}
  141.    free_down : longint = 0;    {free downloads}
  142.    graphics : longint = 0;     {graphics callers}
  143.    joins : longint = 0;        {number of conference joins}
  144.    kills : longint = 0;        {messages killed}
  145.    lockouts : longint = 0;     {Automatic lockouts done}
  146.    logsize : word = 0;
  147.    mssgs : longint = 0;        {messages left}
  148.    Qmssgs : longint = 0;       {Qmail messages left}
  149.    new_guys : longint = 0;     {new users registered}
  150.    non_graphics : longint = 0; {non-graphics callers}
  151.    PAGE : longint = 0;         {sysop pages}
  152.    pwfail : longint = 0;       {password fails}
  153.    question : longint = 0;     {main questionnaire answered}
  154.    refused : longint = 0;      {refused to register}
  155.    secviol : longint = 0;      {security violations}
  156.    start_time : real = 0;      {0 time for program start}
  157.    stuff : longint = 0;
  158.    sysop_local : longint = 0;  {local sysop sessions}
  159.    sysop_remote : longint = 0; {remote sysop sessions}
  160.    tcan : longint = 0;         {number of trashcan name attempts}
  161.    time_limit : longint = 0;   {daily time limit exceeded}
  162.    UniqFiles : longint = 0;    {number of dIfferent files}
  163.    up : longint = 0;           {number of uploads}
  164.    u_abort : longint = 0;      {number of upload aborts}
  165.    zipmail : longint = 0;      {number of ARCM runs}
  166.    msgcount : longint = 0;     {number of ARCM messges}
  167.    invalids : longint = 0;     {number of invalid uploads}
  168.  
  169.    schat : longint = 0;        {sysop chat initiated}
  170.    nchat:  longint = 0;        {node chat initiated}
  171.       
  172.    UsedMinutes : longint = 0;  {time used, minutes}
  173.    Hours : longint = 0;        {time used, hours}
  174.    mins_dn : longint = 0;      {minutes spent downloading}
  175.    mins_up : longint = 0;      {minutes spent uploading}
  176.    mins_schat: longint = 0;    {minutes spent in sysop-chat mode}
  177.    mins_nchat: longint = 0;    {minutes spent in node-chat mode}
  178.    DosTime : longint = 0;      {time spent in remote DOS}
  179.    libdisk : longint = 0;
  180.  
  181.    spare1 : longint = 0;
  182.    spare2 : longint = 0;
  183.    spare3 : longint = 0;
  184.    spare4 : longint = 0;
  185.    spare5 : longint = 0;
  186.  
  187.    Inrec : FileStr = '';        {64 char line}
  188.    Urec : anystring = '';       {upper case version of inrec}
  189.  
  190.    PeriodCovered : anystring = ''; {concats to send to ofd}
  191.  
  192.    min_download : longint = 2;       {min downloads to include in report}
  193.  
  194.    outfile : anystring = 'BLT99';    {output filename}
  195.  
  196.    reports : anystring = 'ANBCDEFGHIJKLM';    {list of reports to produce}
  197.  
  198.    {table of peak hours, 'Y'=peak, anything else=not}
  199.                            {          1         2   }
  200.                            {012345678901234567890123}
  201.    PeakTable: string[24] = 'YNNNNNNNNNNNNNNNNYYYYYYY';
  202.  
  203.    FileTree : FilePointer = nil;
  204.    FirstBatch : ItemPointer = nil;
  205.    FirstBullet : ItemPointer = nil;
  206.    FirstConf : ItemPointer = nil;
  207.    FirstDoor : ItemPointer = nil;
  208.  
  209.    filever: integer = 0;
  210.  
  211.    last_rec: anystring = '';     {last entry in log}
  212.    last_entry: anystring = '';   {last entry in log}
  213.  
  214.    first_rec : anystring = '';   {first entry in log}
  215.    first_entry : anystring = ''; {first entry in log}
  216.  
  217.    TotHours : real = 0;          {Total hours from first to last log entry}
  218.    end_hours: real = 0;
  219.    beg_hours: real = 0;
  220.  
  221.    Hrs : array[0..23] of longint = {minutes used by hours}
  222.          (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
  223.  
  224. var
  225.    DiskFile : text;   {caller log}
  226.    ofd : text;        {file that goes to the bulletin}
  227.    iobuf: array[1..10240] of char;
  228.  
  229.  
  230. const
  231.    graph_num = 100;
  232.    graph_set : string[3] = '░▓▒';
  233.  
  234. type
  235.    sort_keys = (percent_sort, name_sort, no_sort);
  236.  
  237. const
  238.    graph_min : longint = 0;
  239.    graph_max : longint = 0;
  240.    graph_lim : real = 0;
  241.    graph_line : longint = 0;
  242.    graph_count : integer = 0;
  243. var
  244.    graph_val : array[1..graph_num] of real;
  245.    graph_title : array[1..graph_num] of string[20];
  246.  
  247. const
  248.    pcol: string = '';
  249.  
  250. procedure setcolor(col: string);
  251. begin
  252.    if pcol <> col then
  253.    begin
  254.       write(ofd,col);
  255.       pcol := col;
  256.    end;
  257. end;
  258.  
  259.  
  260. (* -------------------------------------------------------- *)
  261. procedure section_title(title : anystring);
  262.    begin
  263.       writeln(ofd);
  264.       writeln(ofd, '' : 35-(length(title) div 2),
  265.             red, '-= ', yellow, title, red, ' =-');
  266.       writeln(ofd);
  267.    end;
  268.  
  269.  
  270. procedure empty_section;
  271.    begin
  272.       writeln(ofd, gray, '':34,'**NONE**');
  273.    end;
  274.  
  275.  
  276. procedure start_graph(title : anystring; limit : real);
  277.    begin
  278.       graph_lim := limit;
  279.       graph_max := 0;
  280.       graph_min := 100;
  281.       graph_line := 0;
  282.       graph_count := 0;
  283.       section_title(title);
  284.    end;
  285.  
  286. procedure graph(item : anystring; n : real);
  287.    var
  288.       pct : real;
  289.    begin
  290.       if graph_lim = 0 then
  291.          pct := 0
  292.       else
  293.          pct := abs(n/graph_lim)*100.0;
  294.       if (pct <= 0) or (pct > maxint) then
  295.          exit;
  296.  
  297.       if pct > graph_max then
  298.          graph_max := trunc(pct);
  299.       if pct < graph_min then
  300.          graph_min := trunc(pct*0.7);
  301.  
  302.       if graph_count < graph_num then
  303.          inc(graph_count);
  304.  
  305.       graph_val[graph_count] := n;
  306.       graph_title[graph_count] := item;
  307.    end;
  308.  
  309.  
  310. procedure graph_output(item : anystring; n : real);
  311.    var
  312.       pct : real;
  313.       i : integer;
  314.       w : integer;
  315.       lim : longint;
  316.    begin
  317.       if graph_line < length(graph_set) then
  318.          inc(graph_line)
  319.       else
  320.          graph_line := 1;
  321.  
  322.       if graph_lim = 0 then
  323.          pct := 0
  324.       else
  325.          pct := abs(n/graph_lim*100.0);
  326.  
  327.       if pct > 100 then
  328.          pct := 100;
  329.  
  330.       write(ofd, green, item:20, ': ', white);
  331.  
  332.       if graph_lim < 0 then
  333.          if pct > 99.9 then
  334.             write(ofd, pct:3:0,' % ')
  335.          else
  336.             write(ofd, pct:4:1, '% ')
  337.       else
  338.  
  339.       begin
  340.          if int(graph_lim) <> graph_lim then
  341.             write(ofd, n:5:1)
  342.          else
  343.             write(ofd, n:4:0);
  344.  
  345.          if pct > 99.9 then
  346.             write(ofd,gray, ' (',pct:3:0,' %) ')
  347.          else
  348.             write(ofd,gray,' (', pct:4:1, '%) ');
  349.       end;
  350.  
  351.       if graph_lim < 0 then lim := 50 else lim := 42;
  352.  
  353.       if (pct < graph_min) then
  354.          w := 0
  355.       else
  356.       if (graph_min = graph_max) then
  357.          w := lim
  358.       else
  359.          w := round((pct-graph_min)/(graph_max-graph_min)*lim);
  360.  
  361.       if w > lim then
  362.          w := lim;
  363.  
  364.       write(ofd, white, '│', cyan);
  365.  
  366.       for i := 1 to w-1 do
  367.          write(ofd, graph_set[graph_line]);
  368.       if w > 0 then
  369.          write(ofd, white, '█');
  370.  
  371.       writeln(ofd);
  372.    end;
  373.  
  374.  
  375.    procedure sort_graph(onkey: sort_keys);
  376.    var
  377.       ts : string[20];
  378.       tv : real;
  379.       swap : boolean;
  380.       i,j : integer;
  381.  
  382.       function swap_needed: boolean;
  383.       begin
  384.          if onkey = percent_sort then
  385.             tv := graph_val[i]-graph_val[i+1]
  386.          else
  387.             tv := 0;
  388.          if tv = 0 then
  389.             if graph_title[i] > graph_title[i+1] then
  390.                tv := -1;
  391.          swap_needed := (tv < 0);
  392.       end;
  393.       
  394.       procedure swap_entries;
  395.       begin
  396.          swap := true;
  397.          tv := graph_val[i+1];
  398.          graph_val[i+1] := graph_val[i];
  399.          graph_val[i] := tv;
  400.          ts := graph_title[i+1];
  401.          graph_title[i+1] := graph_title[i];
  402.          graph_title[i] := ts;
  403.       end;
  404.  
  405.    begin
  406.  
  407.      j := graph_count;
  408.      repeat
  409.          swap := false;
  410.          dec(j);
  411.          for i := 1 to j do
  412.             if swap_needed then
  413.                swap_entries;
  414.       until swap = false;
  415.    end;
  416.  
  417.  
  418. procedure end_graph(onkey: sort_keys);
  419.    var
  420.       i : integer;
  421.  
  422.    begin
  423.       if onkey <> no_sort then
  424.          sort_graph(onkey);
  425.  
  426.       for i := 1 to graph_count do
  427.          graph_output(graph_title[i], graph_val[i]);
  428.  
  429.       if graph_count = 0 then
  430.          empty_section;
  431.  
  432.       writeln(ofd);
  433.    end;
  434.  
  435.  
  436. (* -------------------------------------------------------- *)
  437.    procedure graph_list(node: ItemPointer;
  438.                         title: string; 
  439.                         n: real; key: sort_keys);
  440.    begin
  441.       start_graph(title,n);
  442.       while node <> nil do
  443.          begin
  444.             graph(node^.name, node^.count);
  445.             node := node^.next;
  446.          end;
  447.       end_graph(key);
  448.    end;
  449.  
  450.  
  451. (* -------------------------------------------------------- *)
  452. procedure walk_tree( var Node : FilePointer;
  453.                      var a : integer);
  454.    {traverse the binary filename tree and output in sorted order}
  455. begin
  456.    if Node = nil then exit;
  457.  
  458.    walk_tree(Node^.lower, a);
  459.  
  460.    if Node^.count >= min_download then
  461.    begin
  462.       case Node^.count-min_download of
  463.          0.. 2: write(ofd, cyan,   '     ');
  464.          3.. 6: write(ofd, green,  '   * ');
  465.          7..12: write(ofd, red,    '  ** ');
  466.         13..24: write(ofd, yellow, ' *** ');
  467.          else   write(ofd, white,  '**** ');
  468.       end;
  469.  
  470.       write(ofd, Node^.name : 12, Node^.count : 5);
  471.  
  472.       if a mod 3 = 0 then
  473.          writeln(ofd)
  474.       else
  475.          write(ofd,'   ');
  476.  
  477.       inc(a);
  478.    end;
  479.  
  480.    walk_tree(Node^.higher, a);
  481. end;
  482.  
  483.  
  484. (* -------------------------------------------------------- *)
  485. procedure output_results(outfile: anystring);
  486.    var
  487.       UsedHours : real;
  488.       DownEffic : real;
  489.       UpEffic : real;
  490.       temp : anystring;
  491.       Days : longint;
  492.       report : integer;
  493.       c: char;
  494.       PeakUsed : real;
  495.       PeakHours : real;
  496.  
  497.       procedure init_report;
  498.       var
  499.          i,j: integer;
  500.       begin
  501.          gotoxy(15, 15);
  502.          highvideo;
  503.          textcolor(ansicrt.yellow);
  504.          gotoxy(1, 2);
  505.          write('Sending output to ', outfile,' ');
  506.          gotoxy(1, 24);
  507.  
  508.          assign(ofd, outfile);
  509.          rewrite(ofd);
  510.          setTextbuf(ofd,iobuf);
  511.  
  512.          UsedHours := int(UsedMinutes)/60.0+int(Hours);
  513.  
  514.          if TotHours < 1 then
  515.             TotHours := 1;
  516.          Days := trunc((TotHours+23.0)/24.0);
  517.          str(days,temp);
  518.  
  519.          {calculate number of hours in peak times}
  520.          i := 0;
  521.          for j := 0 to 23 do
  522.             if PeakTable[j+1] = 'Y' then
  523.                inc(i);
  524.          if i = 0 then
  525.             i := 24;
  526.          PeakHours := TotHours / 24.0 * int(i);
  527.  
  528.          {calculate time used in peak times}
  529.          if i = 24 then
  530.             PeakUsed := UsedHours
  531.          else
  532.          begin
  533.             PeakUsed := 0;
  534.             for j := 0 to 23 do
  535.                if PeakTable[j+1] = 'Y' then
  536.                   PeakUsed := PeakUsed + int(hrs[j])/60.0;
  537.          end;
  538.  
  539.          writeln(ofd,white);
  540.          writeln(ofd, '                  Calls ', version, ' - Call Analyzer ',pcbversion);
  541.          writeln(ofd, blue, '            ', PeriodCovered);
  542.       end;
  543.  
  544.       procedure system_statistics;
  545.       begin
  546.          section_title('System Statistics for '+temp+' days');
  547.  
  548.          if (caller = 0) or (days = 0) or
  549.             (totHours = 0) or (peakHours = 0) then exit;
  550.  
  551.          write  (ofd, green, '  Directory Scans........ ', white, dirscan:6);
  552.          writeln(ofd, green, '  Messages Left.......... ':33, white, mssgs:6);
  553.  
  554.          write  (ofd, green, '  Doors Opened........... ', white, DOORs:6);
  555.          writeln(ofd, green, '    Comments Left........ ':33, white, comments:6);
  556.  
  557.          write  (ofd, green, '  Downloads Completed.... ', white, down:6);
  558.          writeln(ofd, green, '    Qmail Messages Left.. ':33, white, Qmssgs:6);
  559.  
  560.          write  (ofd, green, '    Different Files...... ', white, UniqFiles:6);
  561.          writeln(ofd, green, '    ZIPM Executed........ ':33, white, zipmail:6);
  562.  
  563.          write  (ofd, green, '    Downloads Aborted.... ', white, d_abort:6);
  564.          writeln(ofd, green, '    ZIPM Messages........ ':33, white, msgcount:6);
  565.  
  566.          write  (ofd, green, '    Free Downloads....... ', white, free_down:6);
  567.          writeln(ofd, green, '  Number of Callers...... ':33, white, caller:6);
  568.  
  569.          write  (ofd, green, '  LIB Executed........... ', white, libdisk:6);
  570.          writeln(ofd, green, '    New Users Registered. ':33, white, new_guys:6);
  571.  
  572.          write  (ofd, green, '  REPACK Executed........ ', white, repacks:6);
  573.          writeln(ofd, green, '    Ave. Calls Per Day... ':33, white, caller/Days:6:1);
  574.  
  575.          write  (ofd, green, '  TEST Executed.......... ', white, testexec:6);
  576.          writeln(ofd, green, '    Ave. Call Duration... ':33, white, (UsedHours*60)/caller:6:1);
  577.  
  578.          write  (ofd, green, '  Uploads Completed...... ', white, up:6);
  579.          writeln(ofd, green, '    Ave. Idle Time....... ':33, white, (TotHours-UsedHours)*60/caller:6:1);
  580.  
  581.          write  (ofd, green, '    Bad Uploads Deleted.. ', white, invalids:6);
  582.          writeln(ofd, green, '  Scripts Completed...... ':33, white, question:6);
  583.  
  584.          write  (ofd, green, '    Uploads Aborted...... ', white, u_abort:6);
  585.          writeln(ofd, green, '  Total Operation Hours.. ':33, white, TotHours:6:1);
  586.  
  587.          write  (ofd, green, '  VIEW Executed.......... ', white, viewexec:6);
  588.          writeln(ofd, green, '    Utilization Hours.... ':33, white, UsedHours:6:1);
  589.  
  590.          write  (ofd, green, '    Members Extracted.... ', white, extmember:6);
  591.          writeln(ofd, green, '    Total Utilization %.. ':33, white, (UsedHours/TotHours)*100:6:1);
  592.  
  593.          write  (ofd, green, '    Members Viewed....... ', white, viewmember:6);
  594.          writeln(ofd, green, '    Peak Utilization %... ':33, white, (PeakUsed/PeakHours)*100:6:1);
  595.          writeln(ofd);
  596.       end;
  597.  
  598.       procedure security_statistics;
  599.       begin
  600.          section_title('Security Statistics');
  601.  
  602.          write  (ofd, '':32);
  603.          writeln(ofd, green, '  Node Chats Initiated... ':33, white, nchat:6);
  604.  
  605.          write  (ofd, green, '  Automatic Lockouts..... ', white, lockouts:6);
  606.          writeln(ofd, green, '  Sysop Chats Initiated.. ':33, white, schat:6);
  607.  
  608.          write  (ofd, green, '  Password Failures...... ', white, pwfail:6);
  609.          writeln(ofd, green, '  Sysop Paged............ ':33, white, PAGE:6);
  610.  
  611.          write  (ofd, green, '  Refused to Register.... ', white, refused:6);
  612.          writeln(ofd, green, '  Sysop Sessions......... ':33, white, sysop_local+sysop_remote:6);
  613.  
  614.          write  (ofd, green, '  Remote DOS Time (min).. ', white, DosTime:6);
  615.          writeln(ofd, green, '  Time Limit Expired..... ':33, white, time_limit:6);
  616.  
  617.          write  (ofd, green, '  Remote Drops to DOS.... ', white, DosTimes:6);
  618.          writeln(ofd, green, '  Trashcan Names......... ':33, white, tcan:6);
  619.  
  620.          write  (ofd, green, '  Scheduled Events....... ', white, events:6);
  621.          writeln(ofd, green, '  Security Violations.... ':33, white, secviol:6);
  622.          writeln(ofd);
  623.       end;
  624.  
  625.       procedure graphic_modes;
  626.       var
  627.          k: longint;
  628.       begin
  629.          k := (graphics+non_graphics+even_parity);
  630.          start_graph('Graphics Modes', k);
  631.          graph('Color Graphics', graphics);
  632.          graph('Non Graphics', non_graphics);
  633.          graph('7 Bit Even-Parity', even_parity);
  634.          end_graph(percent_sort);
  635.       end;
  636.  
  637.       procedure baud_rates;
  638.       begin
  639.          start_graph('Baud Rates', B38400+B19200+B9600+B4800+B2400+B1200+B300);
  640.          graph('38400 BPS', B38400);
  641.          graph('19200 BPS', B19200);
  642.          graph('9600 BPS', B9600);
  643.          graph('4800 BPS', B4800);
  644.          graph('2400 Baud', B2400);
  645.          graph('1200 Baud', B1200);
  646.          graph('300 Baud', B300);
  647.          end_graph(no_sort);
  648.       end;
  649.  
  650.       procedure hourly_usage;
  651.       var
  652.          hits: longint;
  653.          slot: integer;
  654.          a:    integer;
  655.          k:    integer;
  656.          whole_days : real;
  657.  
  658.       begin
  659.          section_title('Average Percent of Hourly Usage');
  660.  
  661.          write(ofd, green, '       00');
  662.          for a := 1 to 23 do
  663.          begin
  664.             if a < 10 then write(ofd,'  ') else write(ofd,' ');
  665.             write(ofd,a);
  666.          end;
  667.          writeln(ofd);
  668.  
  669.          whole_days := int((TotHours+23)/24) * 0.60;
  670.  
  671.          hits := 0;
  672.          for k := 20 downto 1 do 
  673.          begin
  674.             write(ofd, green, k*5 : 3, '%');
  675.             pcol := '';
  676.             setcolor(white);
  677.             write(ofd, ' │ ');
  678.             hits := 0;
  679.  
  680.             for a := 0 to 23 do 
  681.             begin
  682.                c := graph_set[(a mod 3)+1];
  683.                slot := trunc( (hrs[a] / whole_days) / 5);
  684.                if slot > 20 then
  685.                   slot := 20;
  686.  
  687.                if slot = k then
  688.                begin
  689.                   setcolor(white);
  690.                   write(ofd, '██ ');
  691.                end
  692.                else
  693.  
  694.                if slot > k then
  695.                begin
  696.                   setcolor(cyan);
  697.                   write(ofd, c,c,' ');
  698.                   inc(hits);
  699.                end
  700.                else 
  701.  
  702.                begin
  703.                   setcolor(blue);
  704.                   write(ofd, ' · ');
  705.                end;
  706.             end;
  707.  
  708.             writeln(ofd);
  709.          end;
  710.  
  711.          write(ofd, green, '       00');
  712.          for a := 1 to 23 do
  713.          begin
  714.             if a < 10 then write(ofd,'  ') else write(ofd,' ');
  715.             write(ofd,a);
  716.          end;
  717.          writeln(ofd);
  718.  
  719.          write(ofd, yellow, 'Peak: ', red);
  720.          for a := 0 to 23 do
  721.             if PeakTable[a+1] = 'Y' then
  722.                write(ofd,' **')
  723.             else
  724.                write(ofd,'   ');
  725.          writeln(ofd);
  726.          writeln(ofd);
  727.       end;
  728.  
  729.       procedure conferences_joined;
  730.       begin
  731.          graph_list(FirstConf,'Conferences Joined', joins, percent_sort);
  732.       end;
  733.  
  734.       procedure bulletins_read;
  735.       begin
  736.          graph_list(FirstBullet,'Bulletins Read', blts, percent_sort);
  737.       end;
  738.  
  739.       procedure doors_opened;
  740.       begin
  741.          graph_list(FirstDoor,'Doors Opened', DOORs, percent_sort);
  742.       end;
  743.  
  744.       procedure time_distribution;
  745.       begin
  746.       end;
  747.  
  748.       procedure download_protocols;
  749.       var
  750.          k: integer;
  751.       begin
  752.          start_graph('Protocol Usage (Downloading)', down);
  753.          for k := 1 to ProtocolCount do
  754.             with Protocol[k] do
  755.                if (Downloads <> 0) then
  756.                   graph(Name, Downloads);
  757.          end_graph(percent_sort);
  758.       end;
  759.  
  760.       procedure download_efficiency;
  761.       var
  762.          k: integer;
  763.       begin
  764.          start_graph('Average Protocol Efficiency (Downloading)', -100);
  765.          for k := 1 to ProtocolCount do
  766.             with Protocol[k] do
  767.                if (Downloads <> 0) and (DownTime <> 0) then
  768.                   begin
  769.                      DownEffic := 100.0*DownIdeal/DownTime;
  770.                      graph(Name, DownEffic);
  771.                   end;
  772.          end_graph(percent_sort);
  773.       end;
  774.  
  775.       procedure upload_protocols;
  776.       var
  777.          k: integer;
  778.       begin
  779.          start_graph('Protocol Usage (Uploading)', up);
  780.          for k := 1 to ProtocolCount do
  781.             with Protocol[k] do
  782.                if (Uploads <> 0) then
  783.                   graph(Name, Uploads);
  784.          end_graph(percent_sort);
  785.       end;
  786.  
  787.       procedure upload_efficiency;
  788.       var
  789.          k: integer;
  790.       begin
  791.          start_graph('Average Protocol Efficiency (Uploading)', -100);
  792.          for k := 1 to ProtocolCount do
  793.             with Protocol[k] do
  794.                if (Uploads <> 0) and (UpTime <> 0) then
  795.                   begin
  796.                      UpEffic := 100.0*UpIdeal/UpTime;
  797.                      graph(Name, UpEffic);
  798.                   end;
  799.          end_graph(percent_sort);
  800.       end;
  801.  
  802.       procedure batch_sizes;
  803.       begin
  804.          graph_list(FirstBatch,'Batch Transfer Sizes', batchs, name_sort);
  805.       end;
  806.  
  807.       procedure files_downloaded;
  808.       var
  809.          a: integer;
  810.          s: anystring;
  811.       begin
  812.          if min_download = 1 then
  813.             s := ''
  814.          else
  815.          begin
  816.             str(min_download,s);
  817.             s := ' '+ s + ' or More Times';
  818.          end;
  819.  
  820.          section_title('Files Downloaded'+s);
  821.          if down < 1 then
  822.             empty_section
  823.          else
  824.             begin
  825.                a := 1;
  826.                walk_tree(FileTree, a);
  827.             end;
  828.          writeln(ofd);
  829.       end;
  830.  
  831. (* -------------------------------------------------------- *)
  832.    begin
  833.       init_report;
  834.  
  835.       for report := 1 to length(reports) do
  836.          case upcase(reports[report]) of
  837.            'A': system_statistics;
  838.            'B': graphic_modes;
  839.            'C': baud_rates;
  840.            'D': hourly_usage;
  841.            'E': conferences_joined;
  842.            'F': bulletins_read;
  843.            'G': doors_opened;
  844.            'H': download_protocols;
  845.            'I': download_efficiency;
  846.            'J': upload_protocols;
  847.            'K': upload_efficiency;
  848.            'L': batch_sizes;
  849.            'M': files_downloaded;
  850.            'N': security_statistics;
  851.            'O': time_distribution;
  852.            'Z': writeln(ofd);
  853.          end;
  854.  
  855.       write(ofd,gray);
  856.       close(ofd);
  857.    end;
  858.  
  859.  
  860.  
  861. (* -------------------------------------------------------- *)
  862. procedure getrec;
  863.    var
  864.       c:    char;
  865.    begin
  866.       Qreadln(DiskFile, Inrec, sizeof(Inrec));
  867.       Urec := Inrec;
  868.       stoupper(Urec);
  869.  
  870.       if Urec[3] = '-' then
  871.          last_rec := Urec;
  872.  
  873.       if keypressed then
  874.       begin
  875.          c := readkey;
  876.          if c = #27 then
  877.          begin
  878.             gotoxy(1, 24);
  879.             writeln('** ESC pressed - Aborted **');
  880.             delay(2000);
  881.             halt;
  882.          end;
  883.       end;
  884.    end;
  885.  
  886.  
  887.  
  888. (* -------------------------------------------------------- *)
  889. procedure add_item(var FirstItem : ItemPointer;
  890.                    ItemName : anystring;
  891.                    Number : integer);
  892. var
  893.    NewItem : ItemPointer;
  894.  
  895. begin
  896.    NewItem := FirstItem;
  897.    while NewItem <> nil do
  898.       if NewItem^.name = ItemName then
  899.          begin
  900.             NewItem^.count := NewItem^.count + Number;
  901.             exit;
  902.          end
  903.       else
  904.          NewItem := NewItem^.next;
  905.  
  906.    new(NewItem);          { get a new record}
  907.    NewItem^.next := FirstItem;
  908.    FirstItem := NewItem;
  909.    NewItem^.name := ItemName;
  910.    NewItem^.count := Number;
  911. end;
  912.  
  913.  
  914. (* -------------------------------------------------------- *)
  915. procedure store_name(var Node : FilePointer;
  916.                      var Name : anystring;
  917.                      var Size : longint);
  918.       {stores the name in the sorted name tree; recursive}
  919.  
  920.    begin
  921.  
  922.       if Urec[8] = 'U' then
  923.       begin
  924.          size := 100000;
  925.          exit;
  926.       end;
  927.  
  928.  
  929.       (* insert new nodes *)
  930.       if Node = nil then
  931.       begin
  932.          new(Node);
  933.          Node^.count := 1;
  934.          Node^.name := Name;
  935.          Node^.size := 100000;
  936.          Size := Node^.size;
  937.          Node^.higher := nil;
  938.          Node^.lower := nil;
  939.          inc(UniqFiles);
  940.       end
  941.       else
  942.  
  943.       (* count existting nodes *)
  944.       if Node^.name = Name then
  945.       begin
  946.          inc(Node^.count);
  947.          Size := Node^.size;
  948.       end
  949.       else
  950.  
  951.       (* else traverse the tree looking for the right node *)
  952.       if Name > Node^.name then
  953.          store_name(Node^.higher,Name,Size)
  954.       else
  955.          store_name(Node^.lower,Name,Size);
  956.    end;
  957.  
  958.  
  959. (* -------------------------------------------------------- *)
  960. type
  961.    str12 = string[12];
  962.    str80 = string[80];
  963.  
  964. {  This Function returns a name expanded to line up both the name and ext    }
  965. {  for example:  abc.com      =  abc      com                                }
  966. {                datafile.1   =  datafile   1                                }
  967.  
  968. function ExpandName(name : str12) : str12;
  969.  
  970.    var
  971.       Counter, DotPos : integer;
  972.  
  973.    begin
  974.       DotPos := pos('.', name); {where's the dot at?}
  975.       if DotPos = 0 then begin
  976.          repeat
  977.             name := name+' '; {If no ext, pad with spaces}
  978.          until length(name) = 12;
  979.       end else begin
  980.          delete(name, DotPos, 1);
  981.          repeat
  982.             insert(' ', name, DotPos);
  983.          until length(name) = 12;
  984.       end;
  985.       ExpandName := name;
  986.    end;
  987.  
  988.  
  989. (* -------------------------------------------------------- *)
  990. procedure print(col, row : integer;
  991.                 str : str80;
  992.                 Attrib : integer);
  993.    begin
  994.       gotoxy(col, row);
  995.       textcolor(Attrib);
  996.       write(str);
  997.    end;
  998.  
  999.  
  1000. (* -------------------------------------------------------- *)
  1001. function Time : real;
  1002.  
  1003.    var
  1004.       Reg : Registers;
  1005.  
  1006.    begin Reg.AX := $2C00;
  1007.       intr($21, Reg);
  1008.       Time := (Reg.CX shr 8)*3600 {Hours}
  1009.       +(Reg.CX and $00FF)*60 {Minutes}
  1010.       +(Reg.DX shr 8)      { * 1 }
  1011.                            {Seconds    }
  1012.       +(Reg.DX and $00FF)/100; {Hundredths }
  1013.    end;
  1014.  
  1015.  
  1016.  
  1017. (* -------------------------------------------------------- *)
  1018. procedure incaller;
  1019.    var
  1020.       Str30 : string[30];
  1021.       posit : integer;
  1022.       str20 : string[20];
  1023.  
  1024.    begin
  1025.  
  1026.       if pos(') (',copy(Urec,23,99)) = 0 then
  1027.          exit;
  1028.  
  1029.       if pos(' SYSOP (', Urec) > 0 then
  1030.          begin
  1031.             if pos(' (LOCAL) (', Urec) > 0 then
  1032.                inc(sysop_local)
  1033.             else
  1034.                inc(sysop_remote);
  1035.          end;
  1036.  
  1037.       if pos(' (LOCAL) (', Urec) <> 0 then
  1038.       begin
  1039.          inc(Blocal);
  1040.          baud := 0;
  1041.       end
  1042.       else
  1043.  
  1044.       if pos(' (38400) (', Urec) <> 0 then
  1045.       begin
  1046.          inc(B38400);
  1047.          baud := 14400;
  1048.       end
  1049.       else
  1050.  
  1051.       if pos(' (19200) (', Urec) <> 0 then
  1052.       begin
  1053.          inc(B19200);
  1054.          baud := 9600;
  1055.       end
  1056.       else
  1057.  
  1058.       if pos(' (9600) (', Urec) <> 0 then
  1059.       begin
  1060.          inc(B9600);
  1061.          baud := 9600;
  1062.       end
  1063.       else
  1064.  
  1065.       if pos(' (4800) (', Urec) <> 0 then
  1066.       begin
  1067.          inc(B4800);
  1068.          baud := 4800;
  1069.       end
  1070.       else
  1071.  
  1072.       if pos(' (2400) (', Urec) <> 0 then
  1073.       begin
  1074.          inc(B2400);
  1075.          baud := 2400;
  1076.       end
  1077.       else
  1078.  
  1079.       if pos(' (1200) (', Urec) <> 0 then
  1080.       begin
  1081.          inc(B1200);
  1082.          baud := 1200;
  1083.       end
  1084.       else
  1085.  
  1086.       if pos(' (300) (', Urec) <> 0 then
  1087.       begin
  1088.          inc(B300);
  1089.          baud := 300;
  1090.       end;
  1091.  
  1092.       if pos('(G', Urec) > 0 then inc(graphics)
  1093.       else if pos('(N', Urec) > 0 then inc(non_graphics)
  1094.       else if pos('(7', Urec) > 0 then inc(even_parity);
  1095.  
  1096.       caller := Blocal+B300+B1200+B2400+B4800+B9600+B19200+B38400;
  1097.  
  1098.       if pos(' TRASHCAN ', Urec) > 0 then inc(tcan);
  1099.  
  1100.    end;
  1101.  
  1102.  
  1103. (* -------------------------------------------------------- *)
  1104. procedure indownload;      {upload/downloaded file stuff}
  1105.    var
  1106.       prot : char;
  1107.       posit : integer;
  1108.       k : integer;
  1109.       CPS : real;
  1110.       FileName : string[12];
  1111.       tmp: string;
  1112.       size : longint;
  1113.       ideal : real;
  1114.       Time : real;
  1115.  
  1116.    begin
  1117.       if Urec[9] <> ')' then exit;
  1118.  
  1119.       if pos(' ABORTED ', Urec) > 0 then
  1120.       begin
  1121.          if Urec[8] = 'D' then
  1122.             inc(d_abort) {Aborted dl's}
  1123.          else
  1124.             inc(u_abort);
  1125.          exit;
  1126.       end;
  1127.  
  1128.       posit := pos(' COMPLETED ', Urec); {find End of name}
  1129.       if posit=0 then exit;
  1130.  
  1131.       {determine file name}
  1132.       FileName := copy(Urec, 11, (posit-11));
  1133.       FileName := ExpandName(FileName);
  1134.       if FileName[1] = ' ' then exit;
  1135.  
  1136.       {store name, return file size}
  1137.       store_name(FileTree,FileName,size);
  1138.  
  1139.       {determine transfer time}
  1140.       if baud <> 0 then
  1141.          ideal := size/baud*10.0
  1142.       else
  1143.          ideal := 111;
  1144.  
  1145.       {determine actual transfer time}
  1146.       posit := pos('CPS=', Urec);
  1147.       if posit = 0 then
  1148.          CPS := baud/11.0
  1149.       else
  1150.       begin
  1151.          tmp := copy(Urec,posit+4,6);
  1152.          posit := pos(' ',tmp);
  1153.          tmp := copy(tmp,1,posit-1);
  1154.          CPS := 0;
  1155.          val(tmp,cps,posit);
  1156.       end;
  1157.  
  1158.       if (CPS < 20) or (CPS > (baud/5.0)) then
  1159.       begin
  1160.          Time := 0;     {don't consider aborted or invalid transfers}
  1161.          ideal := 0;
  1162.       end
  1163.       else
  1164.          Time := size/CPS;
  1165.  
  1166.       {determine protocol and find table entry}
  1167.       posit := pos(' USING ', Urec);
  1168.       prot := Urec[posit+7];
  1169.  
  1170.       for k := 1 to ProtocolCount do
  1171.       with Protocol[k] do
  1172.  
  1173.          if (Code = prot) or (Code = '?') then
  1174.          begin
  1175.             if Code = '?' then
  1176.             begin
  1177.                gotoxy(1,3);
  1178.                writeln('Unknown protocol: ',Urec);
  1179.             end;
  1180.  
  1181.             if Urec[8] = 'D' then
  1182.             begin
  1183.                inc(Downloads);
  1184.                DownTime := DownTime+Time;
  1185.                DownIdeal := DownIdeal+ideal;
  1186.                inc(down);
  1187.                mins_dn := mins_dn + round(Time/60.0);
  1188.             end
  1189.             else
  1190.             begin
  1191.                inc(Uploads);
  1192.                UpTime := UpTime+Time;
  1193.                UpIdeal := UpIdeal+ideal;
  1194.                inc(up);
  1195.                mins_up := mins_up + round(Time/60.0);
  1196.             end;
  1197.  
  1198.             exit;
  1199.          end;
  1200.    end;
  1201.  
  1202.  
  1203. (* -------------------------------------------------------- *)
  1204. procedure confjoin;        {conferences joined}
  1205.  
  1206.    var
  1207.       posit : integer;
  1208.       ConfName : anystring;
  1209.  
  1210.    begin
  1211.       posit := pos(' CONFERENCE', Urec);
  1212.       if posit < 8 then
  1213.          exit;
  1214.  
  1215.       ConfName := copy(Inrec, 7, 10);
  1216.       posit := pos(' ',ConfName);
  1217.       if posit > 0 then
  1218.          ConfName[0] := chr(posit-1);
  1219.  
  1220.       case ConfName[1] of
  1221.          '0'..'9', 'a'..'z', 'A'..'Z':
  1222.          begin
  1223.             inc(joins);
  1224.             add_item(FirstConf, ConfName, 1);
  1225.          end;
  1226.       end;
  1227.    end;
  1228.  
  1229.  
  1230. (* -------------------------------------------------------- *)
  1231. procedure batch;        {batch transfer}
  1232.  
  1233.    var
  1234.       posit : integer;
  1235.       num : integer;
  1236.       temp : anystring;
  1237.       BatchName : anystring;
  1238.  
  1239.    begin
  1240.       posit := pos(' FILES', Urec);
  1241.       temp := copy(Urec,7,posit-7);
  1242.       num := 0;
  1243.       val(temp,num,posit);
  1244.       if num < 1 then
  1245.          exit;
  1246.       if Urec[posit+7] = '0' then
  1247.          exit;
  1248.  
  1249.       str(num:2,temp);
  1250.       if num = 1 then
  1251.          BatchName := '  Single Files'
  1252.       else
  1253.          BatchName := temp + ' Files';
  1254.  
  1255.       batchs := batchs + num;
  1256.       add_item(FirstBatch, BatchName, num);
  1257.    end;
  1258.  
  1259.  
  1260. (* -------------------------------------------------------- *)
  1261. procedure zipmsgs;        {ziphived message count}
  1262.    var
  1263.       posit : integer;
  1264.       num : integer;
  1265.    
  1266.    begin
  1267.       posit := pos(' MESSA', Urec);
  1268.       num := 0;
  1269.       val(copy(Urec,7,posit-7),num,posit);
  1270.       if num < 1 then
  1271.          exit;
  1272.       msgcount := msgcount + num;
  1273.    end;
  1274.  
  1275.  
  1276. (* -------------------------------------------------------- *)
  1277. type
  1278.    Days = integer;
  1279. var
  1280.    numdays : integer;
  1281.  
  1282. function finday(Days : integer) : integer;
  1283.  
  1284.    begin
  1285.       case Days of
  1286.          12 : numdays := 334;
  1287.          11 : numdays := 304;
  1288.          10 : numdays := 273;
  1289.          9 : numdays := 243;
  1290.          8 : numdays := 212;
  1291.          7 : numdays := 181;
  1292.          6 : numdays := 151;
  1293.          5 : numdays := 120;
  1294.          4 : numdays := 90;
  1295.          3 : numdays := 59;
  1296.          2 : numdays := 31;
  1297.          1 : numdays := 0;
  1298.       end;                 {case}
  1299.       finday := numdays;
  1300.    end;
  1301.  
  1302.  
  1303. (* -------------------------------------------------------- *)
  1304. procedure bulletins;
  1305.  
  1306.    var
  1307.       posit : integer;
  1308.       BltNumber:  anystring;
  1309.       BltName:    anystring;
  1310.  
  1311.    begin
  1312.       BltName := copy(Inrec, 22, 10);
  1313.       posit := pos(' ', BltName);
  1314.       if posit > 0 then
  1315.          BltName[0] := chr(posit-1);
  1316.       if length(BltName) = 0 then
  1317.          exit;
  1318.  
  1319.       posit := pos('#', Inrec);
  1320.       if posit = 0 then
  1321.          exit;
  1322.       BltNumber := copy(Inrec,posit+2,4);
  1323.       posit := pos(' ', BltNumber);
  1324.       if posit > 0 then
  1325.          BltNumber[0] := chr(posit-1);
  1326.       while length(BltNumber) < 3 do
  1327.          BltNumber := ' ' + BltNumber;
  1328.  
  1329.       BltName := BltName + ' #' + BltNumber;
  1330.       inc(blts);
  1331.       add_item(FirstBullet, BltName, 1);
  1332.    end;                    {bulletins}
  1333.  
  1334.  
  1335. (* -------------------------------------------------------- *)
  1336. procedure pdoors;
  1337.  
  1338.    var
  1339.       posit : integer;
  1340.       DoorName : string[40];
  1341.  
  1342.    begin
  1343.       if pos(' AT ', Urec) = 0 then exit;
  1344.  
  1345.       posit := pos('(', Inrec);
  1346.       if posit = 0 then exit;
  1347.  
  1348.       DoorName := copy(Inrec, posit+1, pos(')', Inrec)-posit-1);
  1349.  
  1350.       posit := 1;
  1351.       repeat
  1352.          if DoorName[posit] = '\' then
  1353.             begin
  1354.                DoorName := copy(DoorName, posit+1, 99);
  1355.                posit := 1;
  1356.             end
  1357.          else
  1358.             posit := posit+1;
  1359.       until posit = length(DoorName);
  1360.  
  1361.       inc(DOORs);
  1362.       add_item(FirstDoor, DoorName, 1);
  1363.    end;
  1364.  
  1365.  
  1366. (* -------------------------------------------------------- *)
  1367. procedure DOSdrop;
  1368.  
  1369.    var
  1370.       DT1, DT2 : integer;
  1371.       a: integer;
  1372.  
  1373.    begin
  1374.       val(copy(Urec, 34, 2), DT1, a); {exit to DOS time}
  1375.  
  1376.       getrec;
  1377.       val(copy(Urec, 27, 2), DT2, a); {back from DOS time}
  1378.       if a = 0 then 
  1379.       begin
  1380.          DT1 := (DT2-DT1);
  1381.          if DT1 < 0 then DT1 := DT1+60; {adjust for hour rollover}
  1382.          DosTime := DosTime+DT1;
  1383.       end;
  1384.       inc(DosTimes);
  1385.    end;
  1386.  
  1387.  
  1388. (* -------------------------------------------------------- *)
  1389. procedure sysop_chat;
  1390.  
  1391.    var
  1392.       DT1, DT2 : integer;
  1393.       a: integer;
  1394.       node: boolean;
  1395.  
  1396.    begin
  1397.       node := (Urec[7] = 'N');
  1398.       val(copy(Urec, 34, 2), DT1, a); {chat started time time}
  1399.  
  1400.       getrec;
  1401.       val(copy(Urec, 27, 2), DT2, a); {chat ended time}
  1402.       if a = 0 then 
  1403.       begin
  1404.          DT1 := (DT2-DT1);
  1405.          if DT1 < 0 then DT1 := DT1+60; {adjust for hour rollover}
  1406.          if node then
  1407.             mins_nchat := mins_nchat + DT1
  1408.          else
  1409.             mins_schat := mins_schat + DT1;
  1410.       end;
  1411.  
  1412.       if node then
  1413.          inc(nchat)
  1414.       else
  1415.          inc(schat);
  1416.    end;
  1417.  
  1418.  
  1419. (* -------------------------------------------------------- *)
  1420. procedure mins_used;
  1421.    var
  1422.       a, y, p : integer;
  1423.       minutoff,
  1424.       houroff,
  1425.       timeused : integer;
  1426.  
  1427.    begin
  1428.       p := pos(':', Urec)+2;
  1429.       y := p;
  1430.       while (Urec[y] >= '0') and (Urec[y] <= '9') do
  1431.          inc(y);
  1432.       val(copy(Urec, p, y-p), timeused, a);
  1433.  
  1434.       getrec;
  1435.       val(copy(Urec, 11, 2), houroff, a);
  1436.       if houroff > 23 then
  1437.          houroff := houroff - 24;
  1438.       val(copy(Urec, 14, 2), minutoff, a);
  1439.  
  1440.       while timeused > 0 do
  1441.       begin
  1442.          if timeused > minutoff then
  1443.             a := minutoff
  1444.          else
  1445.             a := timeused;
  1446.  
  1447.          UsedMinutes := UsedMinutes + a;
  1448.          while UsedMinutes > 60 do
  1449.          begin
  1450.             inc(Hours);
  1451.             UsedMinutes := UsedMinutes - 60;
  1452.          end;
  1453.  
  1454.          Hrs[houroff] := Hrs[houroff]+a;
  1455.          timeused := timeused-a;
  1456.  
  1457.          if houroff > 0 then
  1458.             dec(houroff)
  1459.          else
  1460.             houroff := 23;
  1461.          minutoff := 60;
  1462.       end;
  1463.    end;
  1464.  
  1465.  
  1466. (* -------------------------------------------------------- *)
  1467. procedure catchall;
  1468.    begin
  1469.       if pos(' CHAT ', Urec)              > 0 then sysop_chat
  1470.       else if pos('ACCESS DENIED', Urec)  > 0 then inc(tcan)
  1471.       else if pos('COMMENT ', Urec)       > 0 then inc(comments)
  1472.       else if pos('OPENED DOOR ', Urec)   > 0 then pdoors
  1473.       else if pos('MINUTES USED', Urec)   > 0 then mins_used
  1474.       else if pos('NOT REGISTERED', Urec) > 0 then inc(secviol)
  1475.       else if pos('OCK-', Urec)           > 0 then inc(lockouts)
  1476.       else if pos('OINED', Urec)          > 0 then confjoin
  1477.       else if pos('PAGED', Urec)          > 0 then inc(PAGE)
  1478.       else if pos('QUESTIONNAIRE ', Urec) > 0 then inc(question)
  1479.       else if pos('REFUSED', Urec)        > 0 then inc(refused)
  1480.       else if pos('SCHEDULED', Urec)      > 0 then inc(events)
  1481.       else if pos('TIME LIMIT', Urec)     > 0 then inc(time_limit)
  1482.       else if pos('VIOLATION', Urec)      > 0 then inc(secviol)
  1483.       else if pos('LEFT:', Urec)          > 0 then inc(mssgs)
  1484.    end;
  1485.  
  1486.  
  1487. (* -------------------------------------------------------- *)
  1488. procedure scanrec;
  1489.    begin
  1490.  
  1491.       if Urec[1] <> ' ' then
  1492.          incaller
  1493.       else
  1494.  
  1495.       case Urec[7] of
  1496.          '*' :;
  1497.  
  1498.          '(' : if Urec[9] <> ')' then inc(stuff)
  1499.                else if Urec[8] = 'D' then indownload
  1500.                else if Urec[8] = 'U' then indownload
  1501.                else catchall;
  1502.  
  1503.          'A' : if pos('ACCESS DENIED', Urec)       > 0 then inc(tcan)
  1504.                else catchall;
  1505.  
  1506.          'B' : if pos('BULLETIN READ:', Urec)      > 0 then bulletins
  1507.                else if pos('BACK FROM DOS', Urec)  > 0 then inc(backdos)
  1508.                else catchall;
  1509.  
  1510.          'C' : if pos('COMMENT ', Urec)            > 0 then inc(comments)
  1511.                else if pos('CALLER EXITED ', Urec) > 0 then DOSdrop
  1512.                else catchall;
  1513.  
  1514.          'D' : if pos('DIRECTORY SCAN ', Urec)     > 0 then inc(dirscan)
  1515.                else catchall;
  1516.  
  1517.          'E' : if pos('EXTRACT M', Urec)           > 0 then inc(extmember)
  1518.                else catchall;
  1519.  
  1520.          'F' : if pos('FILE (', Urec)              > 0 then inc(stuff)
  1521.                else if pos('FREE DOWNLOAD', Urec)  > 0 then inc(free_down)
  1522.                else catchall;
  1523.  
  1524.          'K' : if pos('KEYBOARD TIME',Urec)        > 0 then inc(stuff)
  1525.                else catchall;
  1526.  
  1527.          'I':  if pos('INSUFFICIENT ',Urec)        > 0 then inc(secviol)
  1528.                else if pos('INVALID ARC',Urec)     > 0 then inc(invalids)
  1529.                else if pos('INVALID ZIP',Urec)     > 0 then inc(invalids)
  1530.                else catchall;
  1531.  
  1532.          'M' : if pos('LEFT:', Urec)               > 0 then
  1533.                begin
  1534.                   inc(mssgs);
  1535.                   if pos('VIA QMAIL', Urec) > 0 then
  1536.                      inc(Qmssgs);
  1537.                end
  1538.                else if pos('KILLED:', Urec)        > 0 then inc(kills)
  1539.                else if pos('MINUTES USED', Urec)   > 0 then mins_used
  1540.                else catchall;
  1541.  
  1542.          'N' : if pos('NODE CHAT ENT', Urec)       > 0 then sysop_chat
  1543.                else if pos('NODE CHAT END', Urec)  > 0 then inc(stuff)
  1544.                else catchall;
  1545.  
  1546.          'O' : if pos('OPERATOR', Urec)            > 0 then inc(PAGE)
  1547.                else if pos('OPENED DOOR ', Urec)   > 0 then pdoors
  1548.                else catchall;
  1549.  
  1550.          'P' : if pos('PASSWORD FAILURE (', Urec)  > 0 then inc(pwfail)
  1551.                else if pos('PAKM EXE', Urec)       > 0 then inc(zipmail)
  1552.                else catchall;
  1553.  
  1554.          'R' : if pos('REFUSED', Urec)             > 0 then inc(refused)
  1555.                else if pos('REGISTRATION', Urec)   > 0 then inc(new_guys)
  1556.                else if pos('REPACK ', Urec)        > 0 then inc(repacks)
  1557.                else if pos('REQUEST LIBRARY',Urec) > 0 then inc(libdisk)
  1558.                else catchall;
  1559.  
  1560.          'S' : if pos('SCHEDULED', Urec)           > 0 then inc(events)
  1561.                else if pos('SORRY', Urec)          > 0 then inc(secviol)
  1562.                else if pos('SYSOP CHAT A', Urec)   > 0 then sysop_chat
  1563.                else if pos('SYSOP CHAT E', Urec)   > 0 then inc(stuff)
  1564.                else catchall;
  1565.  
  1566.          'T' : if pos('TIME LIMIT', Urec)          > 0 then inc(time_limit)
  1567.                else if pos('TEST EXECUTED', Urec)  > 0 then inc(testexec)
  1568.                else if pos('THANKS, ', Urec)       > 0 then inc(secviol)
  1569.                else catchall;
  1570.  
  1571.          'V' : if pos('VIEW E', Urec)              = 7 then inc(viewexec)
  1572.                else if pos('VIEW M', Urec)         = 7 then inc(viewmember)
  1573.                else catchall;
  1574.  
  1575.          'Z':  if pos('ZIPM EXE', Urec)            > 0 then inc(zipmail)
  1576.                else catchall;
  1577.  
  1578.          '0'..'9':
  1579.                if pos(' FILES,',Urec)              > 0 then batch
  1580.                else if pos(' MESSAGES ',Urec)      > 0 then zipmsgs
  1581.                else catchall;
  1582.          else
  1583.                catchall;
  1584.       end;
  1585.    end;
  1586.  
  1587.  
  1588. (* -------------------------------------------------------- *)
  1589. procedure jdate(rec: string; var dt: real);
  1590. var
  1591.    a,mostr,daystr,yrstr:   word;
  1592.    frac:                   real;
  1593.    days:                   real;
  1594.    hours:                  real;
  1595.  
  1596. begin
  1597.    val(copy(rec, 7, 2), mostr, a);     {get month}
  1598.    days := finday(mostr);
  1599.  
  1600.    val(copy(rec, 10, 2), daystr, a);   {get day}
  1601.  
  1602.    val(rec[14], YrStr, a);             {last digit of year}
  1603.  
  1604.    val(copy(rec, 1, 2), hours, a); {hour digit of logon}
  1605.    if hours > 23 then
  1606.       hours := hours - 24;
  1607.  
  1608.    val(copy(rec, 4, 2), frac, a);
  1609.    frac := frac/60;
  1610.  
  1611.    dt := hours + (yrstr*365+days+daystr) * 24 + frac;
  1612. end;
  1613.  
  1614.  
  1615. (* -------------------------------------------------------- *)
  1616. procedure scanfile;
  1617.    var
  1618.       tx1:     string[20];
  1619.       tx:      anystring;
  1620.       nrec:    word;
  1621.  
  1622.    begin
  1623.       nrec := 0;
  1624.  
  1625.       while not eof(DiskFile) do
  1626.       begin
  1627.          scanrec;
  1628.  
  1629.          inc(nrec);
  1630.          if (nrec mod 50) = 1 then
  1631.          begin
  1632.             str((int(nrec)/int(logsize)*100.0) : 5 : 1, tx1);
  1633.             tx1 := 'Working.... '+tx1+' %';
  1634.             print(3, 17, tx1, ansicrt.lightred);
  1635.          end;
  1636.  
  1637.          getrec;
  1638.       end;
  1639.  
  1640.       tx1 := 'Working.... 100.0 %';
  1641.       print(3, 17, tx1, ansicrt.cyan);
  1642.  
  1643.       last_entry := copy(last_rec, 11, 5)+' '+copy(last_rec, 1, 8);
  1644.       print(3, 23, 'Last log entry:  '+last_rec, ansicrt.lightgreen);
  1645.       jdate(last_entry,end_hours);
  1646.  
  1647.       {determine the period involved}
  1648.       PeriodCovered := 'Period covered:  From '+first_entry+' to '+last_entry;
  1649.       print(3, 21, PeriodCovered, ansicrt.lightmagenta);
  1650.  
  1651.       TotHours := end_hours-beg_hours;
  1652.       str(TotHours : 5 : 1, TX);
  1653.       TX := concat('Total Hours of Operation: ', TX);
  1654.       print(3, 19, TX, ansicrt.white);
  1655.    end;
  1656.  
  1657.  
  1658. (* -------------------------------------------------------- *)
  1659. procedure openfiles;
  1660.    var
  1661.       TX : string[62];
  1662.       a: integer;
  1663.       inName : string[65];
  1664.       fd:   file of char64;
  1665.  
  1666.    begin
  1667.       if paramcount = 0 then 
  1668.          InName :=  'CALLERS'
  1669.       else 
  1670.          InName := paramstr(1);
  1671.  
  1672.       assign(fd,InName);
  1673.       {$i-} reset(fd); {$i+}
  1674.       if ioresult <> 0 then
  1675.       begin
  1676.          writeln('Cant open caller file: ',InName);
  1677.          halt(1);
  1678.       end;
  1679.  
  1680.       logsize := filesize(fd);
  1681.       close(fd);
  1682.  
  1683.       str(logsize : 5, TX);
  1684.       TX := concat('Total Records in the Callers file: ', TX);
  1685.       print(3, 20, TX, ansicrt.yellow);
  1686.  
  1687.  
  1688.       assign(DiskFile,InName);
  1689.       {$i-} reset(DiskFile); {$i+}
  1690.       if ioresult <> 0 then
  1691.       begin
  1692.          writeln('Cant open caller file: ',InName);
  1693.          halt(1);
  1694.       end;
  1695.  
  1696.       SetTextbuf(diskFile,iobuf);
  1697.  
  1698.       {decode the beginning of the logfile}
  1699.       repeat
  1700.          getrec;
  1701.       until (Urec[3] = '-') or eof(DiskFile);
  1702.  
  1703.       if (first_rec = '') and (not eof(DiskFile)) then
  1704.          first_rec := Urec;
  1705.  
  1706.       first_entry := copy(first_rec, 11, 5)+' '+copy(first_rec, 1, 8);
  1707.       print(3, 22, 'First log entry: '+first_rec, ansicrt.lightgreen);
  1708.  
  1709.       jdate(first_entry,beg_hours);
  1710.    end;
  1711.  
  1712.  
  1713.  
  1714. (* -------------------------------------------------------- *)
  1715.  
  1716. var
  1717.    line: string;
  1718.    xfd: text;
  1719.  
  1720. procedure write_list(node: ItemPointer);
  1721. begin
  1722.    while node <> nil do
  1723.    begin
  1724.       writeln(xfd,node^.name);
  1725.       writeln(xfd,node^.count);
  1726.       node := node^.next;
  1727.    end;
  1728.    writeln(xfd);
  1729. end;
  1730.  
  1731. procedure write_tree(node: FilePointer);
  1732. begin
  1733.    if node = nil then
  1734.       writeln(xfd)
  1735.    else
  1736.    begin
  1737.       writeln(xfd,node^.name);
  1738.       writeln(xfd,node^.size,' ',node^.count);
  1739.       write_tree(node^.higher);
  1740.       write_tree(node^.lower);
  1741.    end;
  1742. end;
  1743.  
  1744.  
  1745. (* -------------------------------------------------------- *)
  1746.  
  1747. procedure read_list(var node: ItemPointer);
  1748. var
  1749.    add:  ItemPointer;
  1750.  
  1751. begin
  1752.    {special case - empty list}
  1753.    Qreadln(xfd,line,sizeof(line));
  1754.    if length(line) = 0 then
  1755.    begin
  1756.       node := nil;
  1757.       exit;
  1758.    end;
  1759.  
  1760.    {insert head of list}
  1761.    new(node);
  1762.    add := node;
  1763.    add^.name := line;
  1764.    readln(xfd,add^.count);
  1765.  
  1766.    {add rest of the list}
  1767.    Qreadln(xfd,line,sizeof(line));
  1768.    while length(line) <> 0 do
  1769.    begin
  1770.       new(add^.next);
  1771.       add := add^.next;
  1772.       add^.name := line;
  1773.       readln(xfd,add^.count);
  1774.  
  1775.       Qreadln(xfd,line,sizeof(line));
  1776.    end;
  1777.  
  1778.    add^.next := nil;
  1779. end;
  1780.  
  1781.  
  1782. procedure read_tree(var node: FilePointer);
  1783. begin
  1784.    Qreadln(xfd,line,sizeof(line));
  1785.    if length(line)=0 then
  1786.       node := nil
  1787.    else
  1788.    begin
  1789.       new(node);
  1790.       node^.name := line;
  1791.       read(xfd,node^.size);
  1792.       readln(xfd,node^.count);
  1793.       read_tree(node^.higher);
  1794.       read_tree(node^.lower);
  1795.    end;
  1796. end;
  1797.  
  1798.  
  1799. (* -------------------------------------------------------- *)
  1800. procedure save_state;
  1801. var
  1802.    i: integer;
  1803.  
  1804. begin
  1805.    gotoxy(1, 1);
  1806.    write('Writing CALLS.SAV...');
  1807.  
  1808.    assign(xfd,'calls.sav');
  1809.    rewrite(xfd);
  1810.    SetTextbuf(xfd,iobuf);
  1811.  
  1812.    writeln(xfd,'-4');
  1813.  
  1814.    writeln(xfd,spare1);
  1815.    writeln(xfd,spare2);
  1816.    writeln(xfd,spare3);
  1817.    writeln(xfd,spare4);
  1818.    writeln(xfd,spare5);
  1819.    writeln(xfd,B38400);
  1820.    writeln(xfd,copy(last_rec,1,62));
  1821.  
  1822.    writeln(xfd,
  1823.            Qmssgs,' ',  libdisk,' ',
  1824.            B4800);
  1825.    writeln(xfd,
  1826.            zipmail,' ', msgcount,' ',
  1827.            invalids,' ',mins_dn,' ',
  1828.            mins_up,' ', mins_schat,' ',
  1829.            nchat,' ',   mins_nchat,' ',
  1830.            testexec,' ', free_down);
  1831.    writeln(xfd,
  1832.            viewexec,' ',      B1200,' ',
  1833.            B19200,' ',       B2400,' ',
  1834.            B300,' ',         B9600,' ',
  1835.            backdos,' ',      batchs);
  1836.    writeln(xfd,
  1837.            Blocal,' ',       blts,' ',
  1838.            caller,' ',       schat,' ',
  1839.            comments,' ',     dirscan,' ',
  1840.            DOORs,' ',        DosTime);
  1841.    writeln(xfd,
  1842.            DosTimes,' ',     down,' ',
  1843.            d_abort,' ',      events,' ',
  1844.            even_parity,' ',  extmember,' ',
  1845.            graphics,' ',     Hours);
  1846.    writeln(xfd,
  1847.            joins,' ',        kills,' ',
  1848.            lockouts,' ',     UsedMinutes,' ',
  1849.            mssgs,' ',        new_guys,' ',
  1850.            non_graphics,' ', PAGE);
  1851.    writeln(xfd,
  1852.            pwfail,' ',       question,' ',
  1853.            repacks,' ',       refused,' ',
  1854.            secviol,' ',      stuff,' ',
  1855.            sysop_local,' ',  sysop_remote);
  1856.    writeln(xfd,
  1857.            tcan,' ',         time_limit,' ',
  1858.            TotHours:0:2,' ', UniqFiles,' ',
  1859.            up,' ',           u_abort,' ',
  1860.            viewmember);
  1861.  
  1862.    writeln(xfd,copy(first_rec,1,62));
  1863.  
  1864.    for i := 1 to ProtocolCount do
  1865.    with Protocol[i] do
  1866.       writeln(xfd,
  1867.                  code,' ',
  1868.                  Uploads,' ',
  1869.                  UpTime:0:2,' ',
  1870.                  UpIdeal:0:2,' ',
  1871.                  Downloads,' ',
  1872.                  DownTime:0:2,' ',
  1873.                  DownIdeal:0:2);
  1874.  
  1875.    for i := 0 to 23 do
  1876.       writeln(xfd,Hrs[i]);
  1877.  
  1878.    write_list(FirstBatch);
  1879.    write_list(FirstBullet);
  1880.    write_list(FirstConf);
  1881.    write_list(FirstDoor);
  1882.    write_tree(FileTree);
  1883.  
  1884.    close(xfd);
  1885. end;
  1886.  
  1887.  
  1888. (* -------------------------------------------------------- *)
  1889. procedure load_state;
  1890. var
  1891.    i: integer;
  1892.    c: char;
  1893.  
  1894. begin
  1895.    assign(xfd,'calls.sav');
  1896.    {$i-} reset(xfd); {$i+}
  1897.    if ioresult <> 0 then
  1898.       exit;
  1899.  
  1900.    SetTextbuf(xfd,iobuf);
  1901.    gotoxy(1, 1);
  1902.    writeln('Loading CALLS.SAV...');
  1903.  
  1904.    read(xfd,filever);
  1905.    if filever <> -4 then
  1906.    begin
  1907.       writeln('Can''t use your old CALLS.SAV file!  Will create a new one.');
  1908.       close(xfd);
  1909.       exit;
  1910.    end;
  1911.  
  1912.    readln(xfd,
  1913.             spare1,     spare2,
  1914.             spare3,     spare4,
  1915.             spare5,     B38400);
  1916.  
  1917.    Qreadln(xfd,last_rec,sizeof(last_rec));
  1918.  
  1919.    read(xfd,
  1920.            Qmssgs,      libdisk,
  1921.            B4800);
  1922.    read(xfd,
  1923.            zipmail,     msgcount,
  1924.            invalids,    mins_dn,
  1925.            mins_up,     mins_schat,
  1926.            nchat,       mins_nchat,
  1927.            testexec,    free_down);
  1928.    read(xfd,
  1929.            viewexec,     B1200,
  1930.            B19200,       B2400,
  1931.            B300,         B9600,
  1932.            backdos,      batchs);
  1933.    read(xfd,
  1934.            Blocal,       blts,
  1935.            caller,       schat,
  1936.            comments,     dirscan,
  1937.            DOORs,        DosTime);
  1938.    read(xfd,
  1939.            DosTimes,     down,
  1940.            d_abort,      events,
  1941.            even_parity,  extmember,
  1942.            graphics,     Hours);
  1943.    read(xfd,
  1944.            joins,        kills,
  1945.            lockouts,     UsedMinutes,
  1946.            mssgs,        new_guys,
  1947.            non_graphics, PAGE);
  1948.    read(xfd,
  1949.            pwfail,       question,
  1950.            repacks,      refused,
  1951.            secviol,      stuff,
  1952.            sysop_local,  sysop_remote);
  1953.    readln(xfd,
  1954.            tcan,         time_limit,
  1955.            TotHours,     UniqFiles,
  1956.            up,           u_abort,
  1957.            viewmember);
  1958.  
  1959.    Qreadln(xfd,first_rec,sizeof(first_rec));
  1960.  
  1961.    repeat
  1962.       read(xfd,c);
  1963.  
  1964.       i := 1;
  1965.       while (i < ProtocolCount) and 
  1966.             (c <> Protocol[i].Code) and
  1967.             (Protocol[i].Code <> '?') do
  1968.          inc(i);
  1969.  
  1970.       with Protocol[i] do
  1971.          readln(xfd,Uploads,
  1972.                     UpTime,
  1973.                     UpIdeal,
  1974.                     Downloads,
  1975.                     DownTime,
  1976.                     DownIdeal);
  1977.    until c = '?';
  1978.  
  1979.    for i := 0 to 23 do
  1980.       readln(xfd,Hrs[i]);
  1981.  
  1982.    read_list(FirstBatch);
  1983.    read_list(FirstBullet);
  1984.    read_list(FirstConf);
  1985.    read_list(FirstDoor);
  1986.    read_tree(FileTree);
  1987.  
  1988.    close(xfd);
  1989.    writeln(^M'                        ');
  1990. end;
  1991.  
  1992.  
  1993.  
  1994. (* -------------------------------------------------------- *)
  1995.  
  1996. procedure init;            {initialize}
  1997.    var
  1998.       a: word;
  1999.  
  2000.    begin
  2001.       elapsed_time := 0;
  2002.       start_time := Time;
  2003.  
  2004.       if paramcount < 1 then
  2005.          begin
  2006.             clrscr;
  2007.             writeln('Usage:    calls CALLERS-FILE OUTPUT-FILE REPORT-LIST MIN-DOWNLOADs PEAK-HOURS');
  2008.             writeln;
  2009.             writeln('CALLERS-FILE is your pcboard CALLER file.  Use "NUL" to repeat previous data.');
  2010.             writeln('OUTPUT-FILE  defaults to ',outfile);
  2011.             writeln('REPORT-LIST  defaults to ',reports);
  2012.             writeln('MIN-DOWNLOAD defaults to ',min_download);
  2013.             writeln;
  2014.             writeln('PEAK-HOURS   defaults to ',PeakTable);
  2015.             writeln('                        {0         1         2   }');
  2016.             writeln('                        {012345678901234567890123}');
  2017.             writeln;
  2018.             writeln('The legal REPORT-LIST letters are:');
  2019.             writeln('   A: system statistics            B: graphic modes');
  2020.             writeln('   C: baud rates                   D: hourly usage');
  2021.             writeln('   E: conferences joined           F: bulletins read');
  2022.             writeln('   G: doors opened                 H: download protocols');
  2023.             writeln('   I: download efficiency          J: upload protocols');
  2024.             writeln('   K: upload efficiency            L: batch sizes');
  2025.             writeln('   M: files downloaded             N: security statistics');
  2026.             writeln('                                   Z: insert a blank line');
  2027.             write('Press Enter:');
  2028.             readln;
  2029.             writeln;
  2030.             writeln('Examples:');
  2031.             writeln;
  2032.             writeln('  calls \pcb\main\caller \gen\blt3');
  2033.             writeln('            ;uses default report list, min-download and peak-hours.');
  2034.             writeln;
  2035.             writeln('  calls \pcb\main\caller \gen\blt3 ABCEFG 4 NNNNNNNNYYYYYYYYYNNNNNNN');
  2036.             writeln('            ;to specify peak hours you MUST also include ');
  2037.             writeln('            ;the report-list and min-download paremeters.');
  2038.             writeln;
  2039.             writeln('  calls nul \gen\blt-usage D');
  2040.             writeln('  calls nul \gen\blt-files M');
  2041.             writeln('            ;repeat previous report date in different formats or to');
  2042.             writeln('            ;alternate output files');
  2043.             halt;
  2044.          end;
  2045.  
  2046.       if paramcount > 1 then
  2047.          outfile := paramstr(2);
  2048.       if paramcount > 2 then
  2049.          reports := paramstr(3);
  2050.       if paramcount > 3 then
  2051.          val(paramstr(4),min_download,a);
  2052.       if paramcount > 4 then
  2053.          PeakTable := paramstr(5);
  2054.  
  2055.       clrscr;
  2056.       print(13,  5, '╔═════════════════════════════════════════════════════╗', lightred);
  2057.       print(13,  6, '║                                                     ║', lightred);
  2058.       print(13,  7, '║                                                     ║', lightred);
  2059.       print(13,  8, '║                                                     ║', lightred);
  2060.       print(13,  9, '║                                                     ║', lightred);
  2061.       print(13, 10, '║                                                     ║', lightred);
  2062.       print(13, 11, '║                                                     ║', lightred);
  2063.       print(13, 12, '║                                                     ║', lightred);
  2064.       print(13, 13, '║                                                     ║', lightred);
  2065.       print(13, 14, '║                                                     ║', lightred);
  2066.       print(13, 15, '╚═════════════════════════════════════════════════════╝', lightred);
  2067.  
  2068.       print(32, 7, pcbversion, lightgreen);
  2069.       print(30, 9, 'Calls v'+version+', '+reldate, lightgreen);
  2070.       print(29, 11, '(c) 1987  Warren Lauzon', lightcyan);
  2071.       print(20, 13, 'Supported by The Tool Shop, 602/279-2673', ansicrt.white);
  2072.       gotoxy(1,1);
  2073.    end;
  2074.  
  2075.  
  2076. (* -------------------------------------------------------- *)
  2077. begin
  2078.  
  2079.    init;
  2080.    load_state;
  2081.    openfiles;
  2082.    scanfile;
  2083.  
  2084.    Endtime := Time;
  2085.    elapsed_time := Endtime-start_time;
  2086.    gotoxy(30, 17);
  2087.    writeln('Elapsed Time:  ', elapsed_time : 6 : 1);
  2088.  
  2089.    output_results(outfile+'G');
  2090.  
  2091.    red := '';
  2092.    green := '';
  2093.    yellow := '';
  2094.    blue := '';
  2095.    magenta := '';
  2096.    cyan := '';
  2097.    white := '';
  2098.    gray := '';
  2099.    output_results(outfile);
  2100.  
  2101.    save_state;
  2102.    gotoxy(1, 25);
  2103.    textcolor(LightGray);
  2104. end.
  2105.  
  2106.